home *** CD-ROM | disk | FTP | other *** search
/ Extra Heft 12 / Extra Heft12.bin / input64 / 05_86.d64 / macros .lsp < prev    next >
Text File  |  1995-08-17  |  3KB  |  99 lines
  1. (EXPAND EXPR (LAMBDA NIL (SETQ 
  2. MACRO-EXPANSION T)))
  3. (NO-EXPAND EXPR (LAMBDA NIL (SETQ 
  4. MACRO-EXPANSION NIL)))
  5. (MACRO-EXPANSION VALUE T)
  6. (FOR MACRO (NLAMBDA L (REPLACE L (
  7. PROG (VAR VON NACH COUNT-FN TEST-FN) (
  8. SETQ VAR (CADR L)) (SETQ VON (EVAL (
  9. CAR (CDDR L)))) (SETQ NACH (EVAL (
  10. CADR (CDDR L)))) (COND ((GREATERP VON 
  11. NACH) (SETQ TEST-FN (QUOTE LESSP)) (
  12. SETQ COUNT-FN (QUOTE SUB1))) (T (SETQ 
  13. TEST-FN (QUOTE GREATERP)) (SETQ 
  14. COUNT-FN (QUOTE ADD1)))) (RETURN (
  15. LIST (QUOTE PROG) (LIST VAR) (LIST (
  16. QUOTE SETQ) VAR VON) (QUOTE LOOP) (
  17. LIST (QUOTE COND) (LIST (LIST TEST-FN 
  18. VAR NACH) (QUOTE (RETURN NIL))) (CONS 
  19. (QUOTE T) (CDDR (CDDR L)))) (LIST (
  20. QUOTE SETQ) VAR (LIST COUNT-FN VAR)) (
  21. QUOTE (GO LOOP))))))))
  22. (SELECTQ MACRO (NLAMBDA L (REPLACE L (
  23. CONS (QUOTE COND) ((LABEL SELECTQ1 (
  24. LAMBDA (X L) (COND ((ATOM (CDR L)) (
  25. LIST (LIST (QUOTE T) (CAR L)))) (T (
  26. CONS (CONS (LIST (COND ((ATOM (CAAR L)
  27. ) (QUOTE EQ)) (T (QUOTE MEMBER))) X (
  28. LIST (QUOTE QUOTE) (CAAR L))) (CDAR L)
  29. ) (SELECTQ1 X (CDR L))))))) (CADR L) (
  30. CDDR L))))))
  31. (REPLACE EXPR (LAMBDA (X Y) (COND (
  32. MACRO-EXPANSION (RPLACA X (CAR Y)) (
  33. RPLACD X (CDR Y))) (T Y))))
  34. (IF MACRO (MLAMBDA L (REPLACE L (LIST 
  35. (QUOTE COND) (LIST (CADR L) (CAR (
  36. CDDR L))) (CONS (QUOTE T) (CDR (CDDR 
  37. L)))))))
  38. (WHILE MACRO (MLAMBDA L (REPLACE L (
  39. LIST (QUOTE PROG) NIL (QUOTE LOOP) (
  40. LIST (QUOTE COND) (LIST (LIST (QUOTE 
  41. NOT) (CADR L)) (LIST (QUOTE RETURN) 
  42. NIL)) (CONS (QUOTE T) (CDDR L))) (
  43. QUOTE (GO LOOP))))))
  44. (REPEAT MACRO (MLAMBDA L (REPLACE L (
  45. LIST (QUOTE PROG) (QUOTE (N)) (LIST (
  46. QUOTE SETQ) (QUOTE N) (EVAL (CADR L)))
  47.  (QUOTE LOOP) (LIST (QUOTE COND) (
  48. LIST (QUOTE (ZEROP N)) (QUOTE (RETURN 
  49. NIL))) (CONS (QUOTE T) (CDDR L))) (
  50. QUOTE (SETQ N (SUB1 N))) (QUOTE (GO 
  51. LOOP))))))
  52. (LET MACRO (MLAMBDA L (REPLACE L (
  53. CONS (CONS (QUOTE LAMBDA) (CONS (
  54. MAPCAR (QUOTE CAR) (CADR L)) (CDDR L))
  55. ) (MAPCAR (QUOTE CADR) (CADR L))))))
  56. (LOCAL MACRO (MLAMBDA L (REPLACE L (
  57. CONS (CONS (QUOTE LAMBDA) (CDR L)) 
  58. NIL))))
  59. (INCR MACRO (MLAMBDA L (REPLACE L (
  60. LIST (QUOTE SETQ) (CADR L) (LIST (
  61. QUOTE ADD1) (CADR L))))))
  62. (DECR MACRO (MLAMBDA L (REPLACE L (
  63. LIST (QUOTE SETQ) (CADR L) (LIST (
  64. QUOTE SUB1) (CADR L))))))
  65. (PUSH MACRO (NLAMBDA L (REPLACE L (
  66. LIST (QUOTE SETQ) (CADR L) (LIST (
  67. QUOTE CONS) (CAR (CDDR L)) (CADR L))))
  68. ))
  69. (POP MACRO (NLAMBDA L (REPLACE L (
  70. LIST (QUOTE PROG1) (LIST (QUOTE CAR) (
  71. CADR L)) (LIST (QUOTE SETQ) (CADR L) (
  72. LIST (QUOTE CDR) (CADR L)))))))
  73. (MCONS MACRO (NLAMBDA L (REPLACE L (
  74. COND ((ATOM (CDDR L)) (CADR L)) (T (
  75. LIST (QUOTE CONS) (CADR L) (CONS (
  76. QUOTE MCONS) (CDDR L))))))))
  77. (NCONS MACRO (NLAMBDA L (REPLACE L (
  78. LIST (QUOTE CONS) (CADR L) NIL))))
  79. (XCONS MACRO (NLAMBDA L (REPLACE L (
  80. LIST (QUOTE CONS) (CAR (CDDR L)) (
  81. CADR L)))))
  82. (FUNCTION MACRO (NLAMBDA L (REPLACE L 
  83. (LIST (QUOTE QUOTE) (CADR L)))))
  84. (F:L MACRO (NLAMBDA L (REPLACE L (
  85. LIST (QUOTE QUOTE) (CONS (QUOTE 
  86. LAMBDA) (CDR L))))))
  87. (Q:L MACRO (NLAMBDA L (REPLACE L (
  88. LIST (QUOTE QUOTE) (CONS (QUOTE 
  89. LAMBDA) (CDR L))))))
  90. (NEQ MACRO (NLAMBDA L (REPLACE L (
  91. LIST (QUOTE NOT) (LIST (QUOTE EQ) (
  92. CADR L) (CAR (CDDR L)))))))
  93. (MACROS VALUE (EXPAND NO-EXPAND 
  94. MACRO-EXPANSION FOR SELECTQ REPLACE 
  95. IF WHILE REPEAT LET LOCAL INCR DECR 
  96. PUSH POP MCONS NCONS XCONS FUNCTION 
  97. F:L Q:L NEQ MACROS))
  98. NIL
  99.